home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue33 / clinic / EventU4.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-04  |  1.7 KB  |  75 lines
  1. unit EventU4;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     CheckBox1: TCheckBox;
  12.     Button1: TButton;
  13.     procedure Button1Click(Sender: TObject);
  14.     procedure CheckBox1Click(Sender: TObject);
  15.   private
  16.     { Private declarations }
  17.   public
  18.   end;
  19.  
  20. var
  21.   Form1: TForm1;
  22.  
  23. implementation
  24.  
  25. {$R *.DFM}
  26.  
  27. uses
  28.   TypInfo;
  29.  
  30. procedure SetHandler(AObject: TObject; Event: String; Enable: Boolean);
  31. const
  32.   { Used for saving old event handler }
  33.   OldHandler: TMethod = (Code: nil; Data: nil);
  34.   { Used for disabling event handler }
  35.   NilMethod: TMethod = (Code: nil; Data: nil);
  36. var
  37.   PropInfo: PPropInfo;
  38. begin
  39.   PropInfo := GetPropInfo(AObject.ClassInfo, Event);
  40.   if not Assigned(PropInfo) then
  41.     raise Exception.CreateFmt(
  42.       'Event %s not found in %s class', [Event, AObject.ClassName]);
  43.   with PropInfo^ do
  44.   begin
  45.     if PropType^.Kind <> tkMethod then
  46.       raise Exception.CreateFmt('%s is not an event', [Event]);
  47.     if Enable then
  48.       SetMethodProp(AObject, PropInfo, OldHandler)
  49.     else
  50.     begin
  51.       OldHandler := GetMethodProp(AObject, PropInfo);
  52.       SetMethodProp(AObject, PropInfo, NilMethod)
  53.     end
  54.   end
  55. end;
  56.  
  57. procedure TForm1.Button1Click(Sender: TObject);
  58. begin
  59.   SetHandler(CheckBox1, 'OnClick', False);
  60.   try
  61.     { This won't trigger the event since it has been disabled }
  62.     CheckBox1.Checked := not CheckBox1.Checked
  63.   finally
  64.     SetHandler(CheckBox1, 'OnClick', True)
  65.   end
  66. end;
  67.  
  68. procedure TForm1.CheckBox1Click(Sender: TObject);
  69. begin
  70.   ShowMessage('The checkbox was clicked by the user');
  71.   { Blah, blah, blah }
  72. end;
  73.  
  74. end.
  75.